home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / dpassf3.f < prev    next >
Text File  |  1989-08-14  |  2KB  |  52 lines
  1.       subroutine dpassf3 (ido,l1,cc,ch,wa1,wa2)
  2. c
  3. c     Double precision version.  -tk
  4. c
  5. C***BEGIN PROLOGUE  DPASSF3
  6. C***REFER TO DCFFTF
  7. C***ROUTINES CALLED  (NONE)
  8. C***END PROLOGUE  DPASSF3
  9.       implicit double precision (a-h,o-z)
  10.       dimension       cc(ido,3,l1)           ,ch(ido,l1,3)           ,
  11.      1                wa1(1)     ,wa2(1)
  12.       data taur,taui /-.5,-.866025403784439/
  13. C***FIRST EXECUTABLE STATEMENT  DPASSF3
  14.       if (ido .ne. 2) go to 102
  15.       do 101 k=1,l1
  16.          tr2 = cc(1,2,k)+cc(1,3,k)
  17.          cr2 = cc(1,1,k)+taur*tr2
  18.          ch(1,k,1) = cc(1,1,k)+tr2
  19.          ti2 = cc(2,2,k)+cc(2,3,k)
  20.          ci2 = cc(2,1,k)+taur*ti2
  21.          ch(2,k,1) = cc(2,1,k)+ti2
  22.          cr3 = taui*(cc(1,2,k)-cc(1,3,k))
  23.          ci3 = taui*(cc(2,2,k)-cc(2,3,k))
  24.          ch(1,k,2) = cr2-ci3
  25.          ch(1,k,3) = cr2+ci3
  26.          ch(2,k,2) = ci2+cr3
  27.          ch(2,k,3) = ci2-cr3
  28.   101 continue
  29.       return
  30.   102 do 104 k=1,l1
  31.          do 103 i=2,ido,2
  32.             tr2 = cc(i-1,2,k)+cc(i-1,3,k)
  33.             cr2 = cc(i-1,1,k)+taur*tr2
  34.             ch(i-1,k,1) = cc(i-1,1,k)+tr2
  35.             ti2 = cc(i,2,k)+cc(i,3,k)
  36.             ci2 = cc(i,1,k)+taur*ti2
  37.             ch(i,k,1) = cc(i,1,k)+ti2
  38.             cr3 = taui*(cc(i-1,2,k)-cc(i-1,3,k))
  39.             ci3 = taui*(cc(i,2,k)-cc(i,3,k))
  40.             dr2 = cr2-ci3
  41.             dr3 = cr2+ci3
  42.             di2 = ci2+cr3
  43.             di3 = ci2-cr3
  44.             ch(i,k,2) = wa1(i-1)*di2-wa1(i)*dr2
  45.             ch(i-1,k,2) = wa1(i-1)*dr2+wa1(i)*di2
  46.             ch(i,k,3) = wa2(i-1)*di3-wa2(i)*dr3
  47.             ch(i-1,k,3) = wa2(i-1)*dr3+wa2(i)*di3
  48.   103    continue
  49.   104 continue
  50.       return
  51.       end
  52.